home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
phycalc.zip
/
PHYCALC.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1992-04-25
|
12KB
|
523 lines
Program PhyCalc;
uses crt,Dos,Graph,Drivers,objects,bgifont,bgidriv;
var
time:LONGint;
gravity:real;
XRange:real;
pic:pointer;
size:word;
mx,my:integer;
oldmouse,newmouse:tpoint;
Kevin,Velocity,Angle,Height:real;
sigfig:integer;
measurement:integer;
degreemode:boolean;
HV,VV:real;
quit:boolean;
Datainterval:real;
SX,SY:real;
ENERGY:REAL;
MASS :Real;
procedure Abort(Msg : string);
begin
Writeln(Msg, ': ', GraphErrorMsg(GraphResult));
Halt(1);
end;
Function Namemeasure:string;
begin
case measurement of
1:namemeasure:='m';
2:namemeasure:='km';
3:namemeasure:='mm';
4:namemeasure:='cm';
5:namemeasure:='ft';
6:namemeasure:='mi';
end;
end;
Procedure Grscreen;
var
gd,gm:integer;
begin
if RegisterBGIdriver(@CGADriverProc) < 0 then
Abort('CGA');
if RegisterBGIdriver(@EGAVGADriverProc) < 0 then
Abort('EGA/VGA');
if RegisterBGIdriver(@HercDriverProc) < 0 then
Abort('Herc');
if RegisterBGIdriver(@ATTDriverProc) < 0 then
Abort('AT&T');
if RegisterBGIdriver(@PC3270DriverProc) < 0 then
Abort('PC 3270');
{ Register all the fonts }
if RegisterBGIfont(@GothicFontProc) < 0 then
Abort('Gothic');
if RegisterBGIfont(@SansSerifFontProc) < 0 then
Abort('SansSerif');
if RegisterBGIfont(@SmallFontProc) < 0 then
Abort('Small');
if RegisterBGIfont(@TriplexFontProc) < 0 then
Abort('Triplex');
gd:=Vga;
gm:=Vgamed;
if RegisterBGIdriver(@EGAVGADriverProc) < 0 then
Abort('EGA/VGA');
if RegisterBGIfont(@GothicFontProc) < 0 then
Abort('Gothic');
if RegisterBGIfont(@SansSerifFontProc) < 0 then
Abort('SansSerif');
if RegisterBGIfont(@SmallFontProc) < 0 then
Abort('Small');
if RegisterBGIfont(@TriplexFontProc) < 0 then
Abort('Triplex');
initgraph(gd,gm,'');
end;
Procedure init;
begin
initevents;
hidemouse;
gravity:=9.8;
Velocity:=50;
sigfig:=2;
measurement:=1;
Angle:=45;
degreemode:=true;
quit:=false;
SX:=640;
SY:=350;
mass:=1;
end;
Function Convert(X:real):string;
var
n:string;
begin
str(X:sigfig:sigfig,N);
Convert:=N;
end;
Procedure Grbox(X,Y,A,B,C:integer);
begin
Setfillstyle(Solidfill,C);
Bar3d(X,Y,X+A,Y+B,10,topon);
end;
Procedure GetCurenttime;
var
h, m, s, hund : Word;
begin
GetTime(h,m,s,hund);
TIME:= H*360000 + M*6000 + s*100 + HUND;
end;
Function Dsin(x:real):real;
begin
Dsin:=Sin(X*pi/180);
end;
Function Dcos(x:real):real;
begin
Dcos:=cos(X*pi/180);
end;
Function CalcEnergy:real;
begin
Calcenergy:=0.5*mass*Velocity*Velocity;
end;
Procedure Getrange(V,Angle:real);
begin
xrange:=Sqr(v)*dsin(2*angle)/gravity;
end;
Procedure Getheight(V,Angle:real);
begin
Height:=Sqr(v)*sqr(dsin(angle))/(2*gravity);
end;
Procedure initmouse; {initializes the mouse}
begin
Oldmouse.x:=mousewhere.x;
oldmouse.y:=mousewhere.Y;
Size := ImageSize(10+7*oldmouse.X-3,50+11*oldmouse.Y-3,10+7*oldmouse.X+3,50+11*oldmouse.Y+3);
GetMem(Pic, Size); { Get memory from heap }
GetImage(10+7*oldmouse.X-3,50+11*oldmouse.Y-3,10+7*oldmouse.X+3,50+11*oldmouse.Y+3,Pic^);
setcolor(blue);
circle(10+7*oldmouse.X,50+11*oldmouse.Y,3);
end; {initmouse}
Procedure putmouse; {reads the current mouse position}
begin
newmouse.x:=mousewhere.x;
newmouse.y:=mousewhere.Y;
if not(oldmouse.X=newmouse.X) or not(oldmouse.y=newmouse.y) then
begin
PutImage(10+7*oldmouse.X-3,50+11*oldmouse.Y-3,Pic^,Normalput);
GetImage(10+7*newmouse.X-3, 50+11*newmouse.Y-3,10+7*newmouse.X+3, 50+11*newmouse.Y+3,Pic^);
setcolor(blue);
circle(10+7*newmouse.X, 50+11*newmouse.Y ,3);
Oldmouse.x:= newmouse.x;
oldmouse.y:= newmouse.y;
end;
end; {readmouse}
Function Readinputnumber(X,Y:integer):real;
var
ch:char;
code:integer;
num:string;
n:real;
begin
num:='';
while ord(ch)<>13 do
if keypressed then
begin
ch:=readkey;
if ord(ch)<>13 then num:=num+ch;
outtextxy(X+10*length(num),Y,ch);
end;
val(num,n,code);
readinputnumber:=n;
end;
Procedure Getinfobox;
var
totaltime:longint;
begin
grbox(10,10,615,330,Lightgray);
Settextstyle(Triplexfont,Horizdir,1);
{ grbox(200,20,150,21,Lightred);}
setcolor(blue);
Outtextxy(150,15,'S I M - P R O J E C T I L E');
setcolor(white);
{ok box}
{ grbox(550,150,40,25,red);
Outtextxy(555,150,'Ok');}
{velocity}
grbox(15,50,85,25,red);
Outtextxy(20,50,'Velocity');
grbox(100,50,150,25,red);
Outtextxy(105,50,Convert(VELOCITY));
grbox(250,50,65,25,red);
Outtextxy(254,50,namemeasure+'/S');
{angle}
grbox(15,90,85,25,red);
Outtextxy(20,90,'Angle');
grbox(100,90,215,25,red);
if degreemode then Outtextxy(105,90,Convert(ANGLE)+'°');
if not degreemode then Outtextxy(105,90,Convert(ANGLE)+'r');
{gravitational rate}
grbox(15,130,85,25,red);
Outtextxy(20,130,'Gravity');
grbox(100,130,150,25,red);
Outtextxy(105,130,Convert(Gravity));
grbox(250,130,65,25,red);
Outtextxy(254,130,namemeasure+'/S²');
{RANGE}
Getrange(velocity,angle);
grbox(15,170,85,25,red);
Outtextxy(20,170,'Range');
grbox(100,170,150,25,red);
Outtextxy(105,170,Convert(Xrange));
grbox(250,170,65,25,red);
Outtextxy(254,170,namemeasure);
{Height}
Getheight(velocity,angle);
grbox(15,210,85,25,red);
Outtextxy(20,210,'Height');
grbox(100,210,150,25,red);
Outtextxy(105,210,Convert(Height));
grbox(250,210,65,25,red);
Outtextxy(254,210,namemeasure);
{Horizontal Vector}
Getheight(velocity,angle);
grbox(15,250,85,25,red);
Outtextxy(20,250,'Horiz V');
grbox(100,250,150,25,red);
Outtextxy(105,250,Convert(Dcos(angle)*velocity));
grbox(250,250,65,25,red);
Outtextxy(254,250,namemeasure+'/S');
{Vertical Vector}
Getheight(velocity,angle);
grbox(15,290,85,25,red);
Outtextxy(20,290,'Vert V');
grbox(100,290,150,25,red);
Outtextxy(105,290,Convert(Dsin(angle)*velocity));
grbox(250,290,65,25,red);
Outtextxy(254,290,'S');
{Time of Flight}
grbox(350,50,85,25,red);
Outtextxy(355,50,'Time');
grbox(435,50,100,25,red);
Outtextxy(440,50,Convert((2* dsin(angle)* velocity)/gravity));
grbox(535,50,65,25,red);
Outtextxy(539,50,'S');
{mass}
grbox(350,90,85,25,red);
Outtextxy(355,90,'Mass');
grbox(435,90,100,25,red);
Outtextxy(440,90,convert(mass));
Grbox(535,90,65,25,red);
outtextxy(539,90,'kg');
{ENERGY}
energy:=calcenergy;
grbox(350,130,85,25,red);
Outtextxy(355,130,'Energy');
grbox(435,130,100,25,red);
Outtextxy(440,130,Convert(ENERGY));
grbox(535,130,80,25,red);
Outtextxy(539,130,'kg/'+namemeasure+'S²');
{Max X}
grbox(350,170,85,25,red);
Outtextxy(355,170,'Max X');
grbox(435,170,100,25,red);
Outtextxy(440,170,Convert(SX));
grbox(535,170,65,25,red);
Outtextxy(539,170,namemeasure);
{Max Y}
grbox(350,210,85,25,red);
Outtextxy(355,210,'Max Y');
grbox(435,210,100,25,red);
Outtextxy(440,210,Convert(SY));
grbox(535,210,65,25,red);
Outtextxy(539,210,namemeasure);
{Spreadsheet}
grbox(350,250,200,25,red);
Outtextxy(355,250,'View Spreadsheet');
{Display Projectile}
grbox(350,290,200,25,red);
Outtextxy(355,290,'View Projectile');
end;
Procedure GrProjectile(V,Angle:real);
var
startime,totaltime,fintime:longint;
flightime,HV,VV:real;
X,Y:integer;
begin
Setfillstyle(Solidfill,black);
Clearviewport;
Getrange(V,Angle);
HV:=V*dcos(angle);
VV:=V*dsin(angle);
totaltime:=round((2*V*dsin(angle)/gravity)*100);
getcurenttime;
startime:=time;
fintime:=startime+totaltime;
setcolor(white);
moveto(0,480);
settextstyle(defaultfont,horizdir,1);
repeat
flightime:=(time-startime)/100;
x:=ROUND( HV*flightime);
y:=ROUND( ((VV*flightime) - 0.5*gravity*sqr(flightime)) );
putpixel( round (( 640/SX) *X) ,round(350- (Y*(350/SY)) ),white);
getcurenttime;
BAR(0,0,160,20);
Outtextxy(0,0,convert(flightime)+' '+convert(x)+' '+convert(y));
until time>fintime;
Clearviewport
end;
Procedure EnterVelocity;
Begin
Clearviewport;
Outtextxy(100,100,'Please enter new velocity');
grbox(15,50,85,25,red);
Outtextxy(20,50,'Velocity');
grbox(100,50,150,25,red);
grbox(250,50,65,25,red);
Outtextxy(254,50,namemeasure+'/S');
Velocity:=readinputnumber(105,50);
Clearviewport;
end;
Procedure Entermass;
Begin
Clearviewport;
Outtextxy(100,100,'Please enter new mass');
grbox(15,50,85,25,red);
Outtextxy(20,50,'Mass');
grbox(100,50,150,25,red);
grbox(250,50,65,25,red);
Outtextxy(254,50,'kg');
mass:=readinputnumber(105,50);
Clearviewport;
end;
Procedure EnterGravity;
Begin
Clearviewport;
Outtextxy(100,100,'Please enter new Gravity');
grbox(15,50,85,25,red);
Outtextxy(20,50,'Gravity');
grbox(100,50,150,25,red);
grbox(250,50,65,25,red);
Outtextxy(254,50,namemeasure+'/S²');
Gravity:=readinputnumber(105,50);
Clearviewport;
end;
Procedure EnterSX;
Begin
Clearviewport;
Outtextxy(100,100,'Please enter maximum X');
grbox(15,50,85,25,red);
Outtextxy(20,50,'Max x');
grbox(100,50,150,25,red);
grbox(250,50,65,25,red);
Outtextxy(254,50,namemeasure);
SX:=readinputnumber(105,50);
Clearviewport;
if SX=0 then entersx;
end;
Procedure EnterSY;
Begin
Clearviewport;
Outtextxy(100,100,'Please enter maximum Y');
grbox(15,50,85,25,red);
Outtextxy(20,50,'Max Y');
grbox(100,50,150,25,red);
grbox(250,50,65,25,red);
Outtextxy(254,50,namemeasure+'M');
SY:=readinputnumber(105,50);
Clearviewport;
if sy=0 then entersy;
end;
Procedure EnterAngle;
begin
Clearviewport;
Outtextxy(100,50,'Please enter new Angle');
grbox(15,90,85,25,red);
Outtextxy(20,90,'Angle');
grbox(100,90,210,25,red);
Angle:=readinputnumber(105,90);
Clearviewport;
end;
Procedure Inputinterval;
begin
Clearviewport;
Outtextxy(100,100,'What is the interval between data cells in seconds ?');
grbox(100,50,150,25,red);
Datainterval:=readinputnumber(105,50);
Clearviewport
end;
Procedure Spreadsheet;
var
flightime,HV,VV:real;
count,thend:Real;
A,B:integer;
C:real;
X,Y:real;
begin
HV:=Velocity*dcos(angle);
VV:=Velocity*dsin(angle);
InputInterval;
count:=0;
a:=30;
b:=0;
thend:=2*velocity*dsin(angle)/gravity;
repeat
x:=(HV*count);
y:=( (VV*count) - 0.5*gravity*sqr(count));
Setcolor(red);
Outtextxy(A,B,convert(count));
Setcolor(green);
Outtextxy(A+100,B,convert(X));
Setcolor(lightgray);
Outtextxy(a+200,B,convert(y));
B:=B+15;
if b>300 then
begin
b:=30;
c:= readinputnumber(0,0);
clearviewport;
end;
count:=count+datainterval;
until count>thend;
c:= readinputnumber(0,0);
Clearviewport;
end;
Procedure Handlevent;
begin
initmouse;
repeat putmouse until (mousebuttons=1) or keypressed;
if keypressed then if readkey='`' then halt;
if (mousewhere.X>50) and (Mousewhere.Y>22) then grprojectile(velocity,angle);
if (mousewhere.X<30) and (mousewhere.Y<4) then EnterVelocity;
if (mousewhere.X<30) and ((mousewhere.Y>4) and (mousewhere.Y<6)) then enterangle;
if (mousewhere.X<30) and ((mousewhere.Y>7) and (mousewhere.Y<9)) then entergravity;
if (mousewhere.X>50) and ((mousewhere.Y<22) and(mousewhere.Y>18) ) then spreadsheet;
if (mousewhere.X>50) and ((mousewhere.Y<17) and(mousewhere.Y>13) ) then entersy;
if (mousewhere.X>50) and ((mousewhere.Y<13) and(mousewhere.Y>10) ) then entersx;
if (mousewhere.X>50) and ((mousewhere.Y<7) and(mousewhere.Y>3) ) then entermass;
end;
Begin
Writeln('This program was created using Turbo Pascal V6.0');
Writeln('Copyright Kevin Helman & Vector Graphics Associates 1992');
Writeln('Feel Free to Distrubute this Program');
Writeln('Use mouse to change options in program');
repeat until keypressed;
Grscreen;
init;
while not quit do
begin
getinfobox;
handlevent;
end;
CLOSEGRAPH;
end.